﻿namespace Idlesoft.ShellAnywhereParser

open System
open System.Collections.Generic
open FParsec
open FParsec.Primitives
open FParsec.CharParsers

//open Idlesoft.Utils
open Idlesoft.ShellAnywhereLanguage

type nf = System.Text.NormalizationForm

//type Parser(verbs : IVerb[], targets : ITarget[]) =
//
//    let registry = new Registry<IParam>()
//    do registry.Register(verbs)
//    do registry.Register(targets)
//    let _open = registry.Find<IVerb>("open").Item

type Parser(registry : IRegistry<IParam>, open_ : IVerb) =

    let _registry = registry
    let _open = open_

    let ws : Parser<_> = spaces

    let ch c = skipChar c >>. ws
    let str s = pstring s .>> ws

    let lparen = ch '('
    let rparen = ch ')'
    let tab = pchar '\t'
    let space = pchar ' '
    let comma = pchar ','
    let period = pchar '.'
    let newline = pchar '\n'
    let underscore = pchar '_'

    let identStart c = isAsciiLetter c || c = '_'
    let identContinue c = isAsciiLetter c || isDigit c || c = '_'
    let identOptions = 
        IdentifierOptions(
            isAsciiIdStart = identStart,
            isAsciiIdContinue = identContinue,
            normalization = nf.FormKC,
            normalizeBeforeValidation = true)

    let ident = identifier identOptions
    let pident = ident |>> Expr.Var

    let stringStart c = isAsciiLetter c || isDigit c || c = '_'
    let stringContinue c = isAsciiLetter c || isDigit c || c = '_' || c = ' '
    let stringOptions =
        IdentifierOptions(
            isAsciiIdStart = stringStart,
            isAsciiIdContinue = stringContinue,
            normalization = nf.FormKC,
            normalizeBeforeValidation = true)

    let string = identifier stringOptions
    let pstring = string |>> Expr.String

    let aoc2str aoc = new System.String(Array.ofList aoc)

    // -?[0-9]+(\.[0-9]*)?([eE][+-]?[0-9]+)?
    let numberFormat =  NumberLiteralOptions.AllowMinusSign
                    ||| NumberLiteralOptions.AllowFraction
                    ||| NumberLiteralOptions.AllowExponent
                    ||| NumberLiteralOptions.AllowSuffix

    let number =
        numberLiteral numberFormat "number"
        |>> fun nl ->
            if nl.IsInteger then Expr.Int (int32 nl.String)
            elif nl.IsDecimal && Char.ToLower(nl.SuffixChar1) = 'f' then Expr.Float (float32 nl.String)
            else Expr.Double (double nl.String)
    
    let opp = new OperatorPrecedenceParser<_,_,_>()
    let exprNoComma = opp.ExpressionParser

    let expr = sepBy1 exprNoComma (ch ',') |>> (List.reduce (fun acc e -> Oper(Var ",", [acc;e])))
    let exprs = many1 expr
    let parenExpr = between lparen rparen expr


    let prim = choice [parenExpr;pident;number;pstring]

    let argList = sepBy exprNoComma (ch ',')
    let oper = between lparen rparen argList |>> (fun args fct -> Oper(fct, args))

    let simpleExpr = pipe2 prim (many oper) (fun prim ops -> List.fold (fun acc elt -> elt acc) prim ops)

    do opp.TermParser <- simpleExpr

    let precedence1 = 
        [
            ["*"; "/"; "%"], Associativity.Left
            ["+"; "-"], Associativity.Left
            ["<<"; ">>"], Associativity.Left
            ["<"; ">"; "<="; ">="], Associativity.Left
            ["=="; "!="], Associativity.Left
            ["&"], Associativity.Left
            ["^"], Associativity.Left
            ["|"], Associativity.Left
            ["&&"], Associativity.Left
            ["^^"], Associativity.Left
            ["||"], Associativity.Left
        ]

    let precedence2 = 
        [
            ["="; "+="; "-="; "*="; "/="; "%="; "<<="; ">>="; "&="; "^="; "|="], Associativity.Right
        ]

    // Add all the operators in the OperatorParser
    let makeOperator =
      // we start with operators with highest priority, then we decrement the counter.
        let precCounter = ref 20 //(we have at most 20 different priorities)
        let addInfix li =
            for ops, assoc in li do
                decr precCounter
                for op in ops do
                    opp.AddOperator(InfixOperator(op, ws, !precCounter, assoc, fun x y -> Oper(Var op, [x; y])))

        let addPrefix() =
            decr precCounter
            for op in ["++"; "--"; "+"; "-"; "~"; "!"] do
                opp.AddOperator(PrefixOperator(op, ws, !precCounter, true, fun x -> Oper(Var op, [x])))

        let addPostfix() =
            decr precCounter
            for op in ["++"; "--"] do
                // the '$' prefix in the name is a trick to distinguish ++a from a++ in the AST
                opp.AddOperator(PostfixOperator(op, ws, !precCounter, true, fun x -> Oper(Var ("$"+op), [x])))

        addPostfix()
        addPrefix()
        addInfix precedence1
        decr precCounter
        opp.AddOperator(TernaryOperator("?", ws, ":", ws, !precCounter, Associativity.Right, fun x y z -> Oper(Var "?:", [x;y;z])))
        addInfix precedence2

//    let lookup (_registry : IRegistry<_>, text : string) =
//        let result = registry.Find<_>(text)
//        result

    let updateVerb (lexeme : ILexeme<IVerb>) = 
        updateUserState(fun us -> {us with Verb = Some lexeme.MatchedItem})

    let udpateTarget (lexeme : ILexeme<ITarget>) = 
        updateUserState(fun us -> {us with Target = Some lexeme.MatchedItem})

    let fail(stream : CharStream<'a>, state : CharStreamState<'a>) = 
        stream.BacktrackTo(state)
        Reply(Error, NoErrorMessages)

//    let hasItems (lexeme : ILexeme<'a>) =
//        (lexeme <> null && lexeme.Count > 0)

    let run parser (input : string) =
        runParserOnString parser UserState.Default "" input

    let If predicate (parser : Parser<_,_>) : Parser<_,_> = 
        fun stream ->
            let state = stream.State
            let reply = parser stream
            if reply.Status <> Ok || predicate reply.Result then reply
            else fail(stream, state)

    let verb : Parser<Matched, UserState> =
        ident .>> ws |> fun parser stream ->
            let state = stream.State
            let reply = parser stream
            if reply.Status = Ok then
                let text = reply.Result
                let v = _registry.Find<IVerb>(text)
                let verbeme = _registry.Find<IVerb>(text)
                if verbeme.IsMatched then
                    Reply(Matched.Verb verbeme.MatchedItem)
                else fail(stream, state)
            else fail(stream, state)

    let target : Parser<Matched, UserState> =
        string .>> ws |> fun parser stream ->
            let state = stream.State
            let reply = parser stream
            if reply.Status = Ok then
                let text = reply.Result
                let targeme = _registry.Find<ITarget>(text)
                if targeme.IsMatched then
                    Reply(Matched.Target targeme.MatchedItem)
                else fail(stream, state)
            else fail(stream, state)

    let paramlist : Parser<Matched, UserState> = 
        ws >>. exprs 
        |>> List.map(fun expr -> new Param(expr.ToString() ) :> IParam ) 
        |>> Matched.ParamList

    let verbeme : Parser<Unmatched, UserState> =
        ident .>> ws |> fun parser stream ->
            let state = stream.State
            let reply = parser stream
            if reply.Status = Ok then
                let text = reply.Result
                let verbeme = _registry.Find<IVerb>(text)
                if verbeme.IsUnmatched then
                    Reply(Unmatched.Verbeme verbeme)
                else fail(stream, state)
            else fail(stream, state)

    let targeme : Parser<Unmatched, UserState> =
        string .>> ws |> fun parser stream ->
            let state = stream.State
            let reply = parser stream
            if reply.Status = Ok then
                let text = reply.Result
                let targeme = _registry.Find<ITarget>(text)
                if targeme.IsUnmatched then
                    Reply(Unmatched.Targeme targeme)
                else fail(stream, state)
            else fail(stream, state)

    let parmeme : Parser<Unmatched, UserState> =
        ident .>> ws |> fun parser stream ->
            let state = stream.State
            let reply = parser stream
            if reply.Status = Ok then
                let text = reply.Result
                let parmeme = _registry.Find<IParam>(text)
                if parmeme.IsUnmatched then
                    Reply(Unmatched.Parmeme parmeme)
                else fail(stream, state)
            else fail(stream, state)

    let exprs = many expr |>> List.ofSeq

    let first(a,_,_) = a
    let second(_,b,_) = b
    let third(_,_,c) = c

    let foreach f  =
        let rec foreachInList l =
            match l with
            | head :: tail -> 
                f head
                foreachInList tail
            | _ -> ()   
        foreachInList

    let success parserResult = 
        parserResult |> fun pr ->
            match pr with
            | Success(r,_,_) -> Some(r)
            | Failure(m,_,_) -> None

    let linearize acc elem = acc |> List.append elem

    let mverb mv =
       match mv with
       | Matched.Verb(v) -> v
       | _ -> null
        
    let mtarget mt =
        match mt with
        | Matched.Target(t) -> t
        | Matched.Verb(v) -> v :?> ITarget
        | _ -> null

    let mparamlist pl =
        match pl with
        | Matched.ParamList(pl) -> pl |> Array.ofList
        | _ -> null

    let uverb uv =
        match uv with
        | Unmatched.Verbeme(lv) -> lv
        | _ -> null

    let utarget ut = 
        match ut with
        | Unmatched.Targeme(lt) -> lt
        | _ -> null

    let uparam up = 
        match up with
        | Unmatched.Parmeme(lp) -> lp
        | _ -> null

    //matched
    let stmtVerbTargetParamList = tuple3 verb target paramlist |>> Stmt.VerbTargetParamList
    let stmtVerbTarget = tuple2 verb target |>> Stmt.VerbTarget
    let stmtTargetParamList = tuple2 target paramlist |>> Stmt.TargetParamList
    let stmtVerb = verb |>> Stmt.Verb
    let stmtTarget = target |>> Stmt.Target
    let stmtParamList = paramlist |>> Stmt.ParamList

    //unmatched
    let stmtVerbTargetParmeme = tuple3 verb target parmeme |>> Stmt.VerbTargetParmeme
    let stmtVerbTargeme = tuple2 verb targeme |>> Stmt.VerbTargeme
    let stmtTargetParmeme = tuple2 target parmeme |>> Stmt.TargetParmeme
    let stmtVerbeme = verbeme |>> Stmt.Verbeme
    let stmtTargeme = targeme |>> Stmt.Targeme
    let stmtParmeme = parmeme |>> Stmt.Parmeme

    let parseVerbTargetParamList = ws >>. stmtVerbTargetParamList .>> eof
    let parseVerbTarget = ws >>. stmtVerbTarget .>> eof
    let parseTargetParamList = ws >>. stmtTargetParamList .>> eof
    let parseVerb = ws >>. stmtVerb .>> eof
    let parseTarget = ws >>. stmtTarget .>> eof
    let parseParamList = ws >>. stmtParamList .>> eof

    let parseVerbTargetParmeme = ws >>. stmtVerbTargetParmeme .>> eof
    let parseVerbTargeme = ws >>. stmtVerbTargeme .>> eof
    let parseTargetParmeme =  ws >>. stmtTargetParmeme .>> eof
    let parseVerbeme = ws >>. stmtVerbeme .>> eof
    let parseTargeme = ws >>. stmtTargeme .>> eof
    let parseParmeme = ws >>. stmtParmeme .>> eof

    let transform (stmt : Stmt) : IShellAction list = 
        let actions = new ResizeArray<IShellAction>()
        match stmt with
        | Stmt.VerbTargetParamList(mv,mt,pl) ->
            let verb = mverb mv
            let target = mtarget mt
            let paramlist = mparamlist pl
            actions.Add(new ShellAction(verb,target, paramlist) )
        | Stmt.VerbTarget(mv,mt) -> 
            let verb = mverb mv
            let target = mtarget mt
            actions.Add(new ShellAction(verb, target, null) )
        | Stmt.TargetParamList(mt,pl) -> 
            let target = mtarget mt
            let paramlist = mparamlist pl
            actions.Add(new ShellAction(_open, target, paramlist) )
        | Stmt.Verb(mv) ->
            let verb = mverb mv
            actions.Add(new ShellAction(verb, null, null) )
        | Stmt.Target(mt) -> 
            let target = mtarget mt
            actions.Add(new ShellAction(_open, target, null) )
        | Stmt.ParamList(pl) -> 
            let paramlist = mparamlist pl
            actions.Add(new ShellAction(null, null, paramlist) )
        | Stmt.VerbTargetParmeme(mv,mt,up) -> 
            let verb = mverb mv
            let target = mtarget mt
            let parmeme = uparam up
            parmeme.Items |> Array.iter(fun param -> actions.Add(new ShellAction(verb, target, param) ) )
        | Stmt.VerbTargeme(mv,ut) ->
            let verb = mverb mv
            let targeme = utarget ut
            targeme.Items |> Array.iter(fun target -> actions.Add(new ShellAction(verb, target, null) ) )
        | Stmt.TargetParmeme(mt,up) ->
            let target = mtarget mt
            let parmeme = uparam up
            parmeme.Items |> Array.iter(fun param -> actions.Add(new ShellAction(_open, target, param) ) )
        | Stmt.Verbeme(uv) ->
            let verbeme = uverb uv
            verbeme.Items |> Array.iter(fun verb -> actions.Add(new ShellAction(verb, null, null) ) )
        | Stmt.Targeme(ut) -> 
            let targeme = utarget ut
            targeme.Items |> Array.iter(fun target -> actions.Add(new ShellAction(_open, target, null) ) )
        | Stmt.Parmeme(up) -> 
            let parmeme = uparam up
            parmeme.Items |> Array.iter(fun param -> actions.Add(new ShellAction(null, null, param) ) )
        actions.ToArray() |> List.ofArray

    member this.Parse(input : string) =
        let stmts = 
            [
                run parseVerbTargetParamList input
                run parseVerbTarget input
                run parseTargetParamList input
                run parseVerb input
                run parseTarget input
                run parseParamList input
                run parseVerbTargetParmeme input
                run parseVerbTargeme input
                run parseTargetParmeme input
                run parseVerbeme input
                run parseTargeme input
                run parseParmeme input
            ]
        stmts
        |> List.choose success
        |> List.map transform
        |> List.fold linearize []
        |> List.toArray

